home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 44 / Amiga Format CD44 (1999-08-26)(Future Publishing)(GB)(Track 1 of 3)[!][issue 1999-10].iso / -in_the_mag- / basics / amos / moreuselssprgs.lha / Diskcruncher2.AMOS / Diskcruncher2.amosSourceCode < prev   
AMOS Source Code  |  1997-04-18  |  7KB  |  274 lines
  1. Screen Open 0,640,200,4,$8000
  2. Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  3. Palette 0,$FFF,$F00,$F0,$F,$F0F,$FF0,$FF,$222,$F80,$F8
  4. Dim REGS(10)
  5. Global GOT$,LVO,RES,LIB$,LIB,FUNK,BASE,REGS()
  6. LVO=0 : DIO=0
  7. CLEARALL
  8. TRACK$="trackdisk.device"+Chr$(0)
  9. Gosub INIT
  10. Gosub OPENDEVICE
  11. If RES Then Print "Error opening "+TRACK$+"!!!" : CLOSALL : End 
  12. Reserve As Work 12,1760*516
  13. BIGBASE=Start(12)
  14. Reserve As Work 11,1760
  15. BITST=Start(11)
  16. Reserve As Work 10,512*22
  17. AD=Start(10)
  18. STT=0
  19. Gosub MOTORON
  20. A=0
  21. OS=880*512 : LE=512
  22. Gosub REEDBLOCK
  23. If Leek(AD+312)<>-1 Then Print "Disk not validated!" : Gosub QUIT : End 
  24. BITMAP=Leek(AD+316)
  25. Print "Bitmapblock:";BITMAP
  26. OS=BITMAP*512 : LE=512
  27. Gosub REEDBLOCK
  28. USED=0
  29. X=0 : Y=0
  30. For A=0 To 1759
  31.   P=Leek(AD+(A+30)/32*4)
  32.   B=Btst((A+30) mod 32,P)
  33.   If A/2=0 Then B=0
  34.   If B=0 Then Inc USED
  35.   Poke BITST+A,B+1
  36.   Ink B+2
  37.   Bar(A/22)*8,(A mod 22)*8 To(A/22)*8+6,(A mod 22)*8+6
  38. Next 
  39. Print "Blocks used:";USED
  40. LX=BIGBASE
  41. For A=0 To 160
  42.   For B=0 To 10
  43.     If Peek(BITST+A*11+B)=1 Then Exit 
  44.   Next 
  45.   If B<11 Then Gosub CRUNCHNSAVE
  46.   If Inkey$<>"" Then Exit 
  47. Next 
  48. Bsave "ram:Disk.dcr",BIGBASE To LX
  49. Gosub QUIT
  50. End 
  51. CRUNCHNSAVE:
  52.   Doke LX,A : Add LX,2
  53.   OS=A*512*11 : LE=512*11 : Gosub REEDBLOCK
  54.   Copy AD,AD+512*11 To AD+512*11
  55.   UN= Extension_5_00CE(AD+512*11,512*11,1,2048,0)
  56.   If UN<1
  57.     Print "Track";A;" not crunched!"
  58.     Doke LX,$FFFF : Add LX,2
  59.     Copy AD,AD+512*11 To LX : Add LX,512*11
  60.   Else 
  61.     Print "Track";A;" crunched to";UN;" bytes len!"
  62.     Doke LX,UN : Add LX,2
  63.     Copy AD+512*11,AD+512*11+UN To LX : Add LX,UN
  64.   End If 
  65. Return 
  66. QUIT:
  67.   Gosub MOTOROFF
  68.   Gosub CLOSDEVICE
  69.   CLOSALL
  70. Return 
  71. INIT:
  72.   LAUFWERK=0
  73.   Reserve As Chip Work 9,128
  74.   OPENLIB["exec"]
  75.   LIPCALL1["exec","FindTask",0]
  76.   TASK=RES
  77.   ST=Start(9)
  78.   For A=1 To Len(TRACK$)
  79.     Poke ST+89+A,Asc(Mid$(TRACK$,A,1))
  80.   Next 
  81.   TRACK=ST+90
  82.   DISKPORT=ST
  83.   Loke ST,0 : Loke ST+4,0 : Doke ST+8,$400 : Loke ST+10,0
  84.   Doke ST+14,31 : Loke ST+16,TASK : Loke ST+20,ST+24
  85.   Loke ST+24,0 : Loke ST+28,ST+20 : Doke ST+32,0
  86.   DISKIO=ST+34
  87.   Loke ST+34,0 : Loke ST+38,0 : Doke ST+42,$500 : Loke ST+44,0
  88.   Loke ST+48,DISKPORT : Doke ST+52,48
  89.   For A=0 To 8
  90.     Loke ST+54+A*4,0
  91.   Next 
  92. Return 
  93. OPENDEVICE:
  94.   DIO=0
  95.   LIPCALL4["exec","OpenDevice",TRACK,LAUFWERK,DISKIO,0]
  96. Return 
  97. MOTORON:
  98.   Doke DISKIO+28,9
  99.   Loke DISKIO+36,1
  100.   If DIO=0 Then LIPCALL1["exec","DoIO",DISKIO] : DIO=1 Else LCALL
  101. Return 
  102. MOTOROFF:
  103.   Doke DISKIO+28,9
  104.   Loke DISKIO+36,0
  105.   If DIO=0 Then LIPCALL1["exec","DoIO",DISKIO] : DIO=1 Else LCALL
  106. Return 
  107. REEDBLOCK:
  108.   Doke DISKIO+28,2
  109.   Loke DISKIO+36,LE
  110.   Loke DISKIO+40,AD
  111.   Loke DISKIO+44,OS
  112.   If DIO=0 Then LIPCALL1["exec","DoIO",DISKIO] : DIO=1 Else LCALL
  113. Return 
  114. CLOSDEVICE:
  115.   DIO=0
  116.   LIPCALL1["exec","CloseDevice",DISKIO]
  117. Return 
  118. End 
  119. Procedure LIPCALL0[N$,F$]
  120.   LIB$=N$ : LIBGET[F$]
  121.   LCALL
  122. End Proc
  123. Procedure LIPCALL1[N$,F$,R1]
  124.   LIB$=N$ : LIBGET[F$]
  125.   REGS(1)=R1
  126.   LCALL
  127. End Proc
  128. Procedure LIPCALL2[N$,F$,R1,R2]
  129.   LIB$=N$ : LIBGET[F$]
  130.   REGS(1)=R1 : REGS(2)=R2
  131.   LCALL
  132. End Proc
  133. Procedure LIPCALL3[N$,F$,R1,R2,R3]
  134.   LIB$=N$ : LIBGET[F$]
  135.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3
  136.   LCALL
  137. End Proc
  138. Procedure LIPCALL4[N$,F$,R1,R2,R3,R4]
  139.   LIB$=N$ : LIBGET[F$]
  140.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4
  141.   LCALL
  142. End Proc
  143. Procedure LIPCALL5[N$,F$,R1,R2,R3,R4,R5]
  144.   LIB$=N$ : LIBGET[F$]
  145.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
  146.   LCALL
  147. End Proc
  148. Procedure LIPCALL6[N$,F$,R1,R2,R3,R4,R5,R6]
  149.   LIB$=N$ : LIBGET[F$]
  150.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
  151.   REGS(6)=R6
  152.   LCALL
  153. End Proc
  154. Procedure LIPCALL7[N$,F$,R1,R2,R3,R4,R5,R6,R7]
  155.   LIB$=N$ : LIBGET[F$]
  156.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
  157.   REGS(6)=R6 : REGS(7)=R7
  158.   LCALL
  159. End Proc
  160. Procedure LIPCALL8[N$,F$,R1,R2,R3,R4,R5,R6,R7,R8]
  161.   LIB$=N$ : LIBGET[F$]
  162.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
  163.   REGS(6)=R6 : REGS(7)=R7 : REGS(8)=R8
  164.   LCALL
  165. End Proc
  166. Procedure LIPCALL9[N$,F$,R1,R2,R3,R4,R5,R6,R7,R8,R9]
  167.   LIB$=N$ : LIBGET[F$]
  168.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
  169.   REGS(6)=R6 : REGS(7)=R7 : REGS(8)=R8 : REGS(9)=R9
  170.   LCALL
  171. End Proc
  172. Procedure LIPCALL10[N$,F$,R1,R2,R3,R4,R5,R6,R7,R8,R9,R10]
  173.   LIB$=N$ : LIBGET[F$]
  174.   REGS(1)=R1 : REGS(2)=R2 : REGS(3)=R3 : REGS(4)=R4 : REGS(5)=R5
  175.   REGS(6)=R6 : REGS(7)=R7 : REGS(8)=R8 : REGS(9)=R9 : REGS(10)=R10
  176.   LCALL
  177. End Proc
  178. Procedure LIBGET[FUNK$]
  179.   ST=Start(15) : LIBS=Leek(ST)
  180.   LIB$=LIB$-".library"+".library"
  181.   FUNK$=Upper$(FUNK$)
  182.   For A=1 To LIBS
  183.     BIN[ST+Leek(ST+A*8-4)]
  184.     If LIB$=GOT$ Then Exit 
  185.   Next 
  186.   If A=LIBS+1 Then Print "FEHLER: Library nicht in LibCall.Dat!" : End 
  187.   If Leek(ST+A*8)=0 Then Print "FEHLER: Library nicht offen!" : End 
  188.   LIB=A
  189.   BASE=ST+Leek(ST+A*8-4)
  190.   For A=1 To Deek(BASE+24)
  191.     BIN[BASE-12+A*44-LVO*4]
  192.     If Upper$(GOT$)=FUNK$ Then Exit 
  193.   Next 
  194.   If A=Deek(BASE+24)+1 Then Print "FEHLER: Funktion nicht gefunden!" : End 
  195.   FUNK=A
  196. End Proc
  197. Procedure LCALL
  198.   For A=1 To 8
  199.     R=Peek(BASE+17+A+FUNK*44)
  200.     If R>0 Then Loke Start(14)+R*4-4,REGS(A)
  201.   Next 
  202.   OFF=-Deek(BASE+16+FUNK*44)
  203.   Loke Start(14)+60,Leek(Start(15)+LIB*8)+OFF
  204.   Loke Start(14)+56,Leek(Start(15)+LIB*8)
  205.   Call Start(14)+64
  206.   RES=Leek(Start(14))
  207. End Proc
  208. Procedure OPENLIB[N$]
  209.   If Length(15)=0
  210.     Open In 1,"dh1:amos/fertig/libcall/LibCall.dat" : L=Lof(1) : GOT$=Input$(1,8) : Close 1
  211.     Reserve As Data 15,L
  212.     Bload "dh1:amos/fertig/libcall/LibCall.dat",15
  213.   End If 
  214.   ST=Start(15) : LIBS=Leek(ST)
  215.   N$=N$-".library"+".library"
  216.   For A=1 To LIBS
  217.     BIN[ST+Leek(ST+A*8-4)]
  218.     If N$=GOT$ Then Exit 
  219.   Next 
  220.   If A=LIBS+1 Then Print "FEHLER: Library nicht in LibCall.Dat!" : End 
  221.   If Leek(ST+A*8)<>0 Then Pop Proc
  222.   If N$="exec.library" Then Loke ST+A*8,Leek(4) : Pop Proc
  223.   Areg(1)=ST+Leek(ST+A*8-4)
  224.   Dreg(0)=0
  225.   Loke ST+A*8,Execall(-552)
  226.   If Leek(ST+A*8)=0 Then Print "FEHLER: Library konnte nicht ge�ffnet werden!" : End 
  227. End Proc
  228. Procedure CLEARALL
  229.   If Length(15)=0 Then Pop Proc
  230.   ST=Start(15)
  231.   For A=1 To Leek(ST)
  232.     Loke ST+A*8,0
  233.   Next 
  234. End Proc
  235. Procedure CLOSLIB[N$]
  236.   If Length(15)=0 Then Print "FEHLER: LibCall.Dat nicht geladen -> keine Library offen!"
  237.   ST=Start(15) : LIBS=Leek(ST)
  238.   N$=N$-".library"+".library"
  239.   For A=1 To LIBS
  240.     BIN[ST+Leek(ST+A*8-4)]
  241.     If N$=GOT$ Then Exit 
  242.   Next 
  243.   If A=LIBS+1 Then Print "FEHLER: Library nicht in LibCall.Dat!" : End 
  244.   If Leek(ST+A*8)=0 Then Pop Proc
  245.   If N$="exec.library" Then Loke ST+A*8,0 : Pop Proc
  246.   Areg(1)=Leek(ST+A*8)
  247.   AD=Execall(-414)
  248.   Loke ST+A*8,0
  249. End Proc
  250. Procedure CLOSALL
  251.   If Length(15)=0 Then Print "FEHLER: LibCall.Dat nicht geladen -> keine Library offen!"
  252.   ST=Start(15) : LIBS=Leek(ST)
  253.   For A=1 To LIBS
  254.     BIN[ST+Leek(ST+A*8-4)]
  255.     If(GOT$<>"exec.library") and(Leek(ST+A*8)<>0)
  256.       Areg(1)=Leek(ST+A*8)
  257.       AD=Execall(-414)
  258.       Loke ST+A*8,0
  259.     Else 
  260.       Loke ST+A*8,0
  261.     End If 
  262.   Next 
  263. End Proc
  264. Procedure GEREG[REGNUM]
  265.   RES=Leek(Start(14)+REGNUM*4)
  266. End Proc
  267. Procedure BIN[AD]
  268.   GOT$=""
  269.   Do 
  270.     CO=Peek(AD) : Inc AD
  271.     Exit If CO=0
  272.     GOT$=GOT$+Chr$(CO)
  273.   Loop 
  274. End Proc